home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
3dtabs
/
tabs.bas
< prev
next >
Wrap
BASIC Source File
|
1995-05-09
|
16KB
|
531 lines
Option Explicit
' used only by demo
Global tabsup%
'constants
Global Const SRCCOPY = &HCC0020
'flags for painting
Dim loading%, resizing%
'general purpose
Dim i%, r%
Type POINTAPI
x As Integer
y As Integer
End Type
Type RECT
left As Integer
top As Integer
right As Integer
bottom As Integer
End Type
Type boxsize
Width As Integer
Height As Integer
End Type
Type twipdata
'scaling constants for each instance
x As Integer 'twips/per/pixelx - depends on parent's scale mode
y As Integer 'twips/per/pixely
bx As Integer 'width of nonclient in twips
by As Integer 'height of nonclient
End Type
'===========structure to hold the size data===========
Type TabData
'control 'properties' - set by caller
num As Integer 'num of Page()'s
active As Integer 'active Page()
orient As Integer 'up = 0, down = 1
cols As Integer 'horz# of tabs
left As Integer 'control left in twips
top As Integer 'control top in twips
offset As Integer 'tab angle
'optional 'properties' - set by caller for sizable windows
minwidth As Integer 'based on size of captions
minheight As Integer 'user-defined
Width As Integer 'width of whole control
Height As Integer 'height of whole control
'optional properties for 'nonaligned' controls
insetx As Integer
insety As Integer
'calculated by DefineControl()
rows As Integer '# of tabs horiz
box As boxsize 'tabbox in pixels
tab As boxsize 'invbox in pixels
'twips or pixels,depending on scalemode of parent:
twp As twipdata
End Type
Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
Declare Sub GetClientRect Lib "User" (ByVal hWnd%, lpRect As RECT)
Declare Function GetParent% Lib "User" (ByVal hWnd%)
Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As RECT)
Sub DefineControl (F As Form, tbox As Control, ibox As Control, page() As Control, tb As TabData)
Dim pageleft%, pagetop%, pageheight%, pagewidth%
Dim tabtop%, aligned%, w%, h%
Dim theight%, pheight%
'
loading = -1
'Debug.Print "=========new run================"
zGetScaleData F, tbox, tb
'note:if any of these values have been set by the caller, then
'the control will be sized to fit them all!
'otherwise the tab and the Form will be fitted to Page(0)
If tb.left = 0 And tb.top = 0 And tb.Width = 0 And tb.Height = 0 Then aligned = -1
'===initialize structure with size of the control======
If tb.cols = 0 Then tb.cols = tb.num + 1
If tb.num = 0 Then tb.num = UBound(page)
If tb.offset = 0 Then tb.offset = 4
If tb.insetx = 0 Then tb.insetx = 8 * tb.twp.x
If tb.insety = 0 Then tb.insety = 8 * tb.twp.y
'
tb.rows = tb.num \ tb.cols + 1
'---set height of invbox & tabbox based on textsize
tb.tab.Height = (tbox.TextHeight("X") + tb.offset)
tb.box.Height = tb.tab.Height * tb.rows
' add 2 pixels to boxheight for 'focus' lines
theight% = (tb.box.Height + 2) * tb.twp.x
'---set an integral pixel width for invbox & tabbox
If aligned Then
pagewidth = page(0).Width \ tb.twp.x
tb.tab.Width = (pagewidth + (2 * tb.insetx \ tb.twp.x)) \ tb.cols
tb.box.Width = tb.tab.Width * tb.cols
tb.Width = tb.box.Width * tb.twp.x
Else
'for 'nonaligned', use tbox.width by default
If tb.Width = 0 Then
tb.tab.Width = (tbox.Width \ tb.cols) \ tb.twp.x
tb.Width = tbox.Width
Else
'adjust the value set by the user
tb.tab.Width = (tb.Width \ tb.cols) \ tb.twp.x
End If
tb.box.Width = tb.tab.Width * tb.cols
pagewidth = tb.box.Width - 2 * tb.insetx \ tb.twp.x
End If
'--- Calculate size of Page() height & inset---------------
If aligned Then
'use page(0) to set control and form height
pageheight = page(0).Height \ tb.twp.y
tb.insetx = (tb.Width - page(0).Width) \ 2
pheight% = page(0).Height + 2 * tb.insety
Else
If tb.Height = 0 Then
'if it wasn't specified, there's no way
'to set it
MsgBox "Must specify a control height: tb.Height = (some value)"
Else
pageheight = (tb.Height - theight%) \ tb.twp.y - 2 * tb.insety \ tb.twp.y
'pheight% = pageheight * tb.twp.y + 2 * tb.insety
pheight% = (tb.Height - theight)
End If
End If
'----height of entire control-----
If aligned Then
tb.Height = theight% + pheight%
End If
'all fields show now be initialized (except minwidth)
'===position it all according to the align paramater=======
pageleft = tb.left + tb.insetx
If tb.orient Then 'tabs down
pagetop = tb.top + tb.insety
tabtop = tb.top + pheight%
Else ' tabs up
pagetop = tb.top + tb.insety + theight%
tabtop = tb.top
End If
'---size all the pages to fit Page(0)
For i = 0 To tb.num
page(i).Move pageleft, pagetop, pagewidth * tb.twp.x, pageheight * tb.twp.y
Next
tbox.Move tb.left, tabtop, tb.Width, theight%
'----Draw the constant elements-----
DrawTabs ibox, tbox, tb
'----now resize the form
w = tb.Width + tb.twp.bx
h = tb.Height + tb.twp.by
If tb.twp.x = 1 Then
w = w * screen.TwipsPerPixelX
h = h * screen.TwipsPerPixelY
End If
If aligned Then
F.Move F.left, F.top, tb.Width + tb.twp.bx, tb.Height + tb.twp.by
End If
page(tb.active).ZOrder
End Sub
Sub DrawTabs (ibox As Control, tbox As Control, tb As TabData)
Debug.Print "Entering DrawTabs------------"
'called by DefineControl
'called by TabResize for sizable windows
Dim n% 'line color (shadow/hilite)
Dim box As RECT
Dim yoff%, xoff% 'inset for angled line
Dim top2% 'hilite/shadow line
Dim invert% '+/- multiplier
Dim x%, y%, res%
Dim n1%, n2%
ibox.Cls
ibox.Move 0, 0, tb.tab.Width, tb.tab.Height
'set color and scale
box.left = 0: box.right = ibox.ScaleWidth - 1
xoff = 4
If tb.orient Then 'tabs down
n = 8 'darkgrey
'tbox.Scale (0, tbox.ScaleHeight - 1)-(tbox.ScaleWidth, -1)
box.bottom = -1
box.top = ibox.ScaleHeight - 1
top2 = box.top - 1
yoff = box.top - 4
invert = -1
Else
n = 15 'white
box.top = 0: box.bottom = ibox.ScaleHeight
top2 = 1
yoff = 4
invert = 1
End If
' Draw black lines
ibox.Line (box.left, yoff)-(xoff, box.top) 'angle
ibox.Line -(box.right - xoff - 1, box.top) 'box.top
ibox.Line (box.right - xoff - 1, box.top)-(box.right, yoff + 1 * invert) 'angle
ibox.Line (box.right, box.top)-(box.right, box.bottom) 'box.right
' Draw white/grey lines
ibox.Line (box.left, box.bottom)-(box.left, yoff + 1 * invert), QBColor(15) 'box.left
ibox.Line -(xoff, top2), QBColor(15) 'angle
ibox.Line -(box.right - xoff - 1, top2), QBColor(n) 'top
ibox.Line -(box.right - 1, yoff + 1 * invert), QBColor(8) 'angle
ibox.Line -(box.right - 1, box.bottom), QBColor(8) 'right
ibox.Line (box.left, box.top)-(box.left, yoff), QBColor(15)
ibox.Line (box.right, box.top)-(box.right, yoff)
ibox.Line (box.right - 1, box.top)-(box.right - 1, yoff), QBColor(8)
'blit to all the lower rows
tbox.Visible = 0
tbox.AutoRedraw = -1
If tb.rows > 1 Then
If tb.orient Then
n1 = 0: n2 = tb.rows - 2
Else
n1 = 1: n2 = tb.rows - 1
End If
For y = n1 To n2
For x = 0 To tb.cols - 1
If tb.orient Then
res = BitBlt(tbox.hDC, x * tb.tab.Width, y * tb.tab.Height + 2, tb.tab.Width, tb.tab.Height + 2, ibox.hDC, 0, 0, SRCCOPY)
Else
res = BitBlt(tbox.hDC, x * tb.tab.Width, y * tb.tab.Height, tb.tab.Width, tb.tab.Height, ibox.hDC, 0, 0, SRCCOPY)
End If
Next: Next
End If
'add some grey for the background
ibox.Line (0, box.top)-(0, yoff), QBColor(8)
ibox.Line (1, box.top)-(1, yoff - 1 * invert), QBColor(8)
ibox.Line (2, box.top)-(2, yoff - 2 * invert), QBColor(8)
ibox.Line (box.right, box.top)-(box.right, yoff + 1 * invert), QBColor(8)
ibox